home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / perl / perlvisi.1 / perlvisi / perlvision / pvbasic.pl < prev    next >
Encoding:
Text File  |  1995-03-22  |  8.0 KB  |  322 lines
  1. require 5.000;
  2.  
  3. # PerlVision - A class library to do ANSI graphics and textmode GUI
  4. # By Ashish Gulhati (hash@well.sf.ca.us)
  5. # V.0.1.0
  6. #
  7. # (C) Ashish Gulhati, 1995. All Rights Reserved.
  8. #
  9. # Free electronic distribution permitted. You are free to use
  10. # PerlVision in your own code so long as this copyright message stays
  11. # intact. PerlVision or derived code may not be used in any commercial
  12. # product without my prior written or PGP-signed consent. Please e-mail 
  13. # me if you make significant changes, or just want to let me know what 
  14. # you're using PerlVision for.
  15.  
  16. package pv;
  17.  
  18. sub initvision {
  19.     my $mode = shift;
  20.     system "stty", '-icanon', '-echo', '-ignbrk', '-isig', '-brkint';
  21.     $|=1;
  22.     ($mode) && (print ("\e[0;11m"));
  23.     ($mode) || (print ("\e[0;10m"));
  24.     $TL=(".","\xDA")[$mode];
  25.     $TR=(".","\xBF")[$mode];
  26.     $HZ=("-","\xC4")[$mode];
  27.     $VT=("|","\xB3")[$mode];
  28.     $BL=("`","\xC0")[$mode];
  29.     $BR=("'","\xD9")[$mode];
  30.     $LB=(" ","\xDD")[$mode];
  31.     $RB=(" ","\xDE")[$mode];
  32.     $TICK=("X","\xFB")[$mode];
  33.     $MARK=("*","\x04")[$mode];
  34.     $VS = &screen;
  35.     $RS = &screen;
  36. }
  37.  
  38. sub exitvision {
  39.     system "stty sane";
  40.     print ("\e[0;10m"); 
  41.     print ("\e[?25h");
  42.     print ("\e[40;37m");
  43.     print ("\e[2J");
  44.     print ("\e[1;1H");
  45. }
  46.  
  47. sub screen {
  48.     my ($i, @qq, @xx);
  49.     for ($i=1; $i<25; $i++) {
  50.     $qq[$i] = &line;
  51.     }
  52.     for ($i=1; $i<25; $i++) {
  53.     $xx[$i] = " " x 81;
  54.     }
  55.     $i = [1,1,0,\@qq,\@xx];
  56. }
  57.  
  58. sub line {
  59.     my ($i, @qq);
  60.     my $param=shift;
  61.     for ($i=1; $i<81; $i++) {
  62.     $qq[$i] = 0;
  63.     }
  64.     $i = \@qq;
  65. }
  66.  
  67. sub pvprint {            # Puts stuff to virtual screen
  68.     my $input = shift;
  69.     $input=~s/\n.*//;
  70.     my $qq=length($input);
  71.     my $i;
  72.     ($qq+$VS[1] >80) && ($qq=80-$VS[1]);
  73.     for ($i=0; $i<$qq; $i++) {
  74.     $VS[3][$VS[0]][$VS[1]+$i]=$VS[2];
  75.     }
  76.     substr($VS[4][$VS[0]],$VS[1],$qq)=substr($input,0,$qq);
  77.     $VS[1]+=$qq;
  78. }
  79.  
  80. sub refresh {            # Compares virtual screen with real screen
  81.     my ($i,$j,$fore,$hi,$back);    # and does a differential update
  82.     my (@rline,@vline,$linebuf,$ypos);
  83.     print ("\e[?25l");        
  84.     my $COLOR=$VS[2];
  85.     $back = $VS[2] % 10;
  86.     $fore = ($VS[2]-$back) / 10;
  87.     $hi = ($fore > 7 ? 1 : 0);
  88.     $fore = ($fore > 7 ? $fore-8 : $fore);
  89.     print "\e[0;$hi;3$fore;4$back"."m";
  90.     for ($i=1;$i<25;$i++) {
  91.     unless (($RS[4][$i] eq $VS[4][$i]) &&
  92.         (join("",@{${$RS[3]}[$i]}) eq join("",@{${$VS[3]}[$i]}))) {
  93.         @rline=split("",$RS[4][$i]);
  94.         @vline=split("",$VS[4][$i]);
  95.         $linebuf="\e[$i;1H";
  96.         my $ypos=1;
  97.         for ($j=1;$j<81;$j++) {
  98.         if ($RS[3][$i][$j]!=$VS[3][$i][$j]) {
  99.             ($ypos!=$j) && ($linebuf.="\e[$i;$j"."H");
  100.             if ($VS[3][$i][$j]!=$COLOR) {
  101.             $back = $VS[3][$i][$j] % 10;
  102.             $fore = ($VS[3][$i][$j]-$back) / 10;
  103.             $hi = ($fore > 7 ? 1 : 0);
  104.             $fore = ($fore > 7 ? $fore-8 : $fore);
  105.             $linebuf.="\e[0;$hi;3$fore;4$back"."m";
  106.             $COLOR = $VS[3][$i][$j];
  107.             }
  108.             $RS[3][$i][$j]=$VS[3][$i][$j];
  109.             $linebuf.=$vline[$j];
  110.             $ypos=$j+1;
  111.         }
  112.         elsif ($rline[$j] ne $vline[$j]) {
  113.             ($ypos!=$j) && ($linebuf.="\e[$i;$j"."H");
  114.             if ($RS[3][$i][$j]!=$COLOR) {
  115.             $back = $RS[3][$i][$j] % 10;
  116.             $fore = ($RS[3][$i][$j]-$back) / 10;
  117.             $hi = ($fore > 7 ? 1 : 0);
  118.             $fore = ($fore > 7 ? $fore-8 : $fore);
  119.             $linebuf.="\e[0;$hi;3$fore;4$back"."m";
  120.             $COLOR = $RS[3][$i][$j];
  121.             }
  122.             $linebuf.=$vline[$j];
  123.             $ypos=$j+1;
  124.         }
  125.         }
  126.         $RS[4][$i]=$VS[4][$i];
  127.         print $linebuf;
  128.     }
  129.     }
  130.     $back = $VS[2] % 10;
  131.     $fore = ($VS[2]-$back) / 10;
  132.     $hi = ($fore > 7 ? 1 : 0);
  133.     $fore = ($fore > 7 ? $fore-8 : $fore);
  134.     print "\e[0;$hi;3$fore;4$back"."m";
  135. }
  136.  
  137. sub redraw {
  138.  
  139. # Will put it in sometime
  140.  
  141. }
  142.  
  143. sub pv_tellregion {
  144.     my ($x1, $y1, $x2, $y2) = @_;
  145.     my ($i, $j, $region);
  146.     my @yy=(); my @qq=(); my @xx=();
  147.     for ($i=$y1; $i<=$y2; $i++) {
  148.     for ($j=$x1; $j<=$x2; $j++) {
  149.         $qq[$i-$y1][$j-$x1]=$RS[3][$i][$j];
  150.     }
  151.     $xx[$i-$y1] = substr($RS[4][$i], $x1, $x2-$x1);
  152.     }
  153.     $region = [\@qq,\@xx];
  154.     return ($region);
  155. }
  156.  
  157. sub pv_putregion {
  158.     my ($x1, $y1, $x2, $y2, $region) = @_;
  159.     my ($i, $j);
  160.     for ($i=$y1; $i<=$y2; $i++) {
  161.     for ($j=$x1; $j<=$x2; $j++) {
  162.         $VS[3][$i][$j] = ${$region->[0]->[$i-$y1]}[$j-$x1];
  163.     }
  164.     substr($VS[4][$i], $x1, $x2-$x1) = $region->[1]->[$i-$y1];
  165.     }
  166. }
  167.  
  168. sub refresh_cursor {
  169.     print ("\e[$VS[0];$VS[1]"); print ("H");
  170.     print ("\e[?25h");
  171. }
  172.  
  173. sub set_cur_pos {
  174.     $VS[1]=shift;
  175.     $VS[0]=shift;
  176. }
  177.  
  178. sub cursor_up {
  179.     ($VS[0]>1) && ($VS[0]--);
  180. }
  181.  
  182. sub cursor_down {
  183.     ($VS[0]<24) && ($VS[0]++);
  184. }
  185.  
  186. sub cursor_forward {
  187.     ($VS[1]<81) && ($VS[1]++);
  188. }
  189.  
  190. sub cursor_back {
  191.     ($VS[1]>1) && ($VS[1]--);
  192. }
  193.  
  194. sub bgcolor {
  195.     if (($_[0] < 8) && ($_[0] >= 0)) {
  196.     $VS[2]=$VS[2]-$VS[2]%10+$_[0];
  197.     }
  198. }
  199.  
  200. sub fgcolor {
  201.     if (($_[0] < 16) && ($_[0] >= 0)) {
  202.     $VS[2]=$VS[2]%10+($_[0]*10);
  203.     }
  204. }
  205.  
  206. sub cls {
  207.     my ($i,$j) = (1,1);
  208.     for ($i=1;$i<25;$i++) {
  209.     for ($j=1;$j<81;$j++) {
  210.         $VS[3][$i][$j]=$VS[2];
  211.         $RS[3][$i][$j]=$VS[2];
  212.     }
  213.     $VS[4][$i]=(" " x 81);
  214.     $RS[4][$i]=(" " x 81);
  215.     }
  216.     my $back = $VS[2] % 10;
  217.     my $fore = ($VS[2]-$back) / 10;
  218.     my $hi = ($fore > 7 ? 1 : 0);
  219.     $fore = ($fore > 7 ? $fore-8 : $fore);
  220.     print "\e[0;$hi;3$fore;4$back"."m";
  221.     print ("\e[2J");
  222.     refresh();
  223. }
  224.  
  225. sub cleol {
  226.     my ($y,$x) = @VS[0..1];
  227.     substr($VS[4][$y],$x,80-$x)= (" " x (80-$x));
  228.     substr($RS[4][$y],$x,80-$x)= (" " x (80-$x));
  229.     for ($x;$x<81;$x++) {
  230.     $VS[3][$y][$x]=$VS[2];
  231.     $RS[3][$y][$x]=$VS[2];
  232.     }
  233.     my $back = $VS[2] % 10;
  234.     my $fore = ($VS[2]-$back) / 10;
  235.     my $hi = ($fore > 7 ? 1 : 0);
  236.     $fore = ($fore > 7 ? $fore-8 : $fore);
  237.     print ("\e[$VS[0];$VS[1]"); print ("H");
  238.     print "\e[0;$hi;3$fore;4$back"."m";
  239.     print ("\e[K");
  240.     refresh();
  241. }
  242.  
  243. sub box {            # Draws your basic 3D box.
  244.     my ($x1,$y1,$x2,$y2,$style,$bgcolor)=@_;
  245.     my $lines=$x2-$x1;
  246.     my $j;
  247.     my ($TOPL,$BOTR);
  248.     if ($style) {$TOPL=15; $BOTR=0}
  249.     else {$TOPL=0; $BOTR=15}
  250.     set_cur_pos($x1,$y1); 
  251.     bgcolor ($bgcolor);
  252.     fgcolor ($TOPL);
  253.     pvprint ($TL); pvprint ($HZ x ($lines-1)); 
  254.     fgcolor ($BOTR); pvprint ($TR); 
  255.     for ($j=$y1+1; $j<$y2; $j++) {
  256.     set_cur_pos($x1,$j);
  257.     fgcolor ($TOPL); pvprint ($VT);
  258.     pvprint (" " x ($lines-1));
  259.     fgcolor ($BOTR); pvprint ($VT); 
  260.     }
  261.     set_cur_pos($x1,$y2); 
  262.     fgcolor ($TOPL); pvprint ($BL); 
  263.     fgcolor ($BOTR); pvprint ($HZ x ($lines-1));
  264.     pvprint ($BR);
  265. }
  266.  
  267. sub standard {            # Makes a standard screen (optimized)
  268.     bgcolor (6); cls; bgcolor(7);
  269.     set_cur_pos (1,1); cleol;
  270.     set_cur_pos (1,2); cleol;
  271.     set_cur_pos (1,3); cleol;
  272.     box (2,1,79,3,1,7);
  273.     box (2,4,79,24,0,6);
  274. }
  275.  
  276. sub getkey {            # Gets a keystroke and returns a code
  277.     my $key = getc;        # and the key if it's printable.
  278.     my $keycode = 0;
  279.     if ($key eq "\e") {
  280.     $key = getc;
  281.     if ($key eq "[") {    # Prolly a keypad key
  282.         $key = getc;
  283.         if ($key =~ /[A-D1-6]/) {
  284.         ($key eq "1") && (getc eq "~") && ($keycode = 1);
  285.         ($key eq "2") && (getc eq "~") && ($keycode = 2);
  286.         ($key eq "3") && (getc eq "~") && ($keycode = 3);
  287.         ($key eq "4") && (getc eq "~") && ($keycode = 4);
  288.         ($key eq "5") && (getc eq "~") && ($keycode = 5);
  289.         ($key eq "6") && (getc eq "~") && ($keycode = 6);
  290.         ($key eq "A") && ($keycode = 7);
  291.         ($key eq "B") && ($keycode = 8);
  292.         ($key eq "C") && ($keycode = 9);
  293.         ($key eq "D") && ($keycode = 10);
  294.         }
  295.     }
  296.     elsif ($key =~ /[WwBbFfIiQqVv<>DdXxHh]/) { # Meta keys
  297.         ($key =~ /[Qq]/) && ($keycode = 11);   # M-q
  298.         ($key eq "" 
  299.          || $key eq "") && ($keycode = 12);  # M-<del>
  300.         ($key =~ /[Bb]/) && ($keycode = 13);   # M-b
  301.         ($key =~ /[Dd]/) && ($keycode = 14);   # M-d
  302.         ($key =~ /[Vv]/) && ($keycode = 15);   # M-v
  303.         ($key eq "<") && ($keycode = 16);      # M-<
  304.         ($key eq ">") && ($keycode = 17);      # M->
  305.         ($key =~ /[Hh]/) && ($keycode = 18);   # M-h
  306.         ($key =~ /[Xx]/) && ($keycode = 19);   # M-x
  307.         ($key =~ /[Ff]/) && ($keycode = 20);   # M-f
  308.         ($key =~ /[Ii]/) && ($keycode = 21);   # M-i
  309.         ($key =~ /[Ww]/) && ($keycode = 22);   # M-w
  310.     }
  311.     else {
  312.         $keycode = 100;
  313.     }
  314.     }
  315.     elsif ($key =~ /[A-Za-z0-9_ \t\n\r~\`!@#\$%^&*()\-+=\\|{}[\];:'"<>,.\/?]/) {
  316.         ($keycode = 200);
  317.     }
  318.     return ($key, $keycode);
  319. }
  320.  
  321. "Perlvision. (C) Ashish Gulhati, 1995";
  322.